home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / tclXmath.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  5.4 KB  |  218 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend
  3. #endif
  4. /*
  5.  * tclXmath.c --
  6.  *
  7.  * Mathematical Tcl commands.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXmath.c,v 2.4 1993/07/11 19:25:19 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21.  
  22. #include "tclExtdInt.h"
  23.  
  24. /*
  25.  * Prototypes of random functions, since we may be using one out of osSupport.
  26.  */
  27. void srandom ();
  28. long random ();
  29.  
  30.  
  31.  
  32. /*
  33.  * Prototypes of internal functions.
  34.  */
  35. int 
  36. really_random _ANSI_ARGS_((int my_range));
  37.  
  38.  
  39. /*
  40.  *-----------------------------------------------------------------------------
  41.  *
  42.  * Tcl_MaxCmd --
  43.  *      Implements the TCL max command:
  44.  *        max num1 num2 ?..numN?
  45.  *
  46.  * Results:
  47.  *      Standard TCL results.
  48.  *
  49.  *-----------------------------------------------------------------------------
  50.  */
  51. int
  52. Tcl_MaxCmd (clientData, interp, argc, argv)
  53.     ClientData  clientData;
  54.     Tcl_Interp *interp;
  55.     int         argc;
  56.     char      **argv;
  57. {
  58.     int    idx,   maxIdx   =  1;
  59. #ifdef THINK_C
  60.     double value, maxValue = -(pow(10.0, 1023));
  61. #else
  62.     double value, maxValue = -MAXDOUBLE;
  63. #endif
  64.  
  65.  
  66.     if (argc < 3) {
  67.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  68.                           " num1 num2 ?..numN?", (char *) NULL);
  69.         return TCL_ERROR;
  70.     }
  71.  
  72.     for (idx = 1; idx < argc; idx++) {
  73.         if (Tcl_GetDouble (interp, argv [idx], &value) != TCL_OK)
  74.             return TCL_ERROR;
  75.         if (value > maxValue) {
  76.             maxValue = value;
  77.             maxIdx = idx;
  78.         }
  79.     }
  80.     strcpy (interp->result, argv [maxIdx]);
  81.     return TCL_OK;
  82. }
  83.  
  84. /*
  85.  *-----------------------------------------------------------------------------
  86.  *
  87.  * Tcl_MinCmd --
  88.  *     Implements the TCL min command:
  89.  *         min num1 num2 ?..numN?
  90.  *
  91.  * Results:
  92.  *      Standard TCL results.
  93.  *
  94.  *-----------------------------------------------------------------------------
  95.  */
  96. int
  97. Tcl_MinCmd (clientData, interp, argc, argv)
  98.     ClientData  clientData;
  99.     Tcl_Interp *interp;
  100.     int     argc;
  101.     char      **argv;
  102. {
  103.     int    idx,   minIdx   = 1;
  104. #ifdef THINK_C
  105.     double value, minValue = (pow(10.0, 1023));
  106. #else
  107.     double value, minValue = MAXDOUBLE;
  108. #endif
  109.  
  110.     if (argc < 3) {
  111.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  112.                           " num1 num2 ?..numN?", (char *) NULL);
  113.         return TCL_ERROR;
  114.     }
  115.  
  116.     for (idx = 1; idx < argc; idx++) {
  117.         if (Tcl_GetDouble (interp, argv [idx], &value) != TCL_OK)
  118.             return TCL_ERROR;
  119.         if (value < minValue) {
  120.             minValue = value;
  121.             minIdx = idx;
  122.             }
  123.         }
  124.     strcpy (interp->result, argv [minIdx]);
  125.     return TCL_OK;
  126. }
  127.  
  128. /*
  129.  *-----------------------------------------------------------------------------
  130.  *
  131.  * ReallyRandom --
  132.  *     Insure a good random return for a range, unlike an arbitrary
  133.  *     random() % n, thanks to Ken Arnold, Unix Review, October 1987.
  134.  *
  135.  *-----------------------------------------------------------------------------
  136.  */
  137. #define RANDOM_RANGE 0x7fffffff
  138.  
  139. static int 
  140.  
  141. ReallyRandom (myRange)
  142.     int myRange;
  143. {
  144.     int maxMultiple, rnum;
  145.  
  146.     maxMultiple = RANDOM_RANGE / myRange;
  147.     maxMultiple *= myRange;
  148.     while ((rnum = random ()) >= maxMultiple)
  149.         continue;
  150.     return (rnum % myRange);
  151. }
  152.  
  153. /*
  154.  *-----------------------------------------------------------------------------
  155.  *
  156.  * Tcl_RandomCmd  --
  157.  *     Implements the TCL random command:
  158.  *     random limit | seed ?seedval?
  159.  *
  160.  * Results:
  161.  *  Standard TCL results.
  162.  *
  163.  *-----------------------------------------------------------------------------
  164.  */
  165. int
  166. Tcl_RandomCmd (clientData, interp, argc, argv)
  167.     ClientData  clientData;
  168.     Tcl_Interp *interp;
  169.     int         argc;
  170.     char      **argv;
  171. {
  172.     unsigned range;
  173.  
  174.     if ((argc < 2) || (argc > 3))
  175.         goto invalidArgs;
  176.  
  177.     if (STREQU (argv [1], "seed")) {
  178.         unsigned seed;
  179.  
  180.         if (argc == 3) {
  181.             if (Tcl_GetUnsigned (interp, argv[2], &seed) != TCL_OK)
  182.                 return TCL_ERROR;
  183.         } else
  184. #ifdef macintosh
  185.             seed = (unsigned) ( time((time_t *)NULL) );
  186. #else
  187.             seed = (unsigned) (getpid() + time((time_t *)NULL));
  188. #endif
  189.  
  190.         srandom (seed);
  191.  
  192.     } else {
  193.         if (argc != 2)
  194.             goto invalidArgs;
  195.         if (Tcl_GetUnsigned (interp, argv[1], &range) != TCL_OK)
  196.             return TCL_ERROR;
  197.         if ((range == 0) || (range > RANDOM_RANGE))
  198.             goto outOfRange;
  199.  
  200.         sprintf (interp->result, "%d", ReallyRandom (range));
  201.     }
  202.     return TCL_OK;
  203.  
  204. invalidArgs:
  205.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  206.                       " limit | seed ?seedval?", (char *) NULL);
  207.     return TCL_ERROR;
  208. outOfRange:
  209.     {
  210.         char buf [18];
  211.  
  212.         sprintf (buf, "%d", RANDOM_RANGE);
  213.         Tcl_AppendResult (interp, "range must be > 0 and <= ",
  214.                           buf, (char *) NULL);
  215.         return TCL_ERROR;
  216.     }
  217. }
  218.